From 673193d55b10ffd39d43595a81aae17f769da09c Mon Sep 17 00:00:00 2001 From: justbur Date: Wed, 1 Jul 2015 20:19:01 -0400 Subject: [PATCH] Initial Commit --- which-key.el | 125 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 125 insertions(+) create mode 100644 which-key.el diff --git a/which-key.el b/which-key.el new file mode 100644 index 00000000000..29c36fc56c7 --- /dev/null +++ b/which-key.el @@ -0,0 +1,125 @@ +;;; which-key.el + +;; Copyright (C) 2015 Justin Burkett + +;; Author: Justin Burkett +;; URL: http://github.com/justbur/which-key/ +;; Version: 0.1 +;; Keywords: +;; Package-Requires: ((s "1.9.0")) + +;;; Commentary: +;; +;; Rewrite of guide-key-mode. +;; + +;;; Code: + +(defvar which-key-timer nil) +(defvar which-key-idle-delay 0.5) +(defvar which-key-max-description-length 30) +(defvar which-key-description-replacement-alist nil) +(defvar which-key-key-replacement-alist + '((">". "") ("<" . "") ("left" ."←") ("right" . "→"))) + +(defvar which-key-buffer-position 'right) +(defvar which-key-buffer-width 80) + +(define-minor-mode which-key-mode + "Toggle which key mode." + :global t + :lighter " WK" + :require 'popwin + :require 's + (funcall (if which-key-mode + 'which-key/turn-on-timer + 'which-key/turn-off-timer))) + +(defsubst which-key/truncate-description (desc) + (if (> (length desc) which-key-max-description-length) + (concat (substring desc 0 which-key-max-description-length) "..") + desc)) + +(defun which-key/format-matches (key-desc-cons max-len-key max-len-desc) + (let* ((key (car key-desc-cons)) + (desc (cdr key-desc-cons)) + (group (string-match-p "^group:" desc)) + (prefix (string-match-p "^Prefix" desc)) + (desc-face (if (or prefix group) + 'font-lock-keyword-face 'font-lock-function-name-face)) + (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc))) + (key-padding (s-repeat (- max-len-key (length key)) " ")) + (padded-desc (s-pad-right max-len-desc " " tmp-desc))) + (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s" + (propertize "]%s" 'face 'font-lock-comment-face) + (propertize " %s" 'face desc-face)) + key key-padding padded-desc))) + +(defun which-key/replace-strings-from-alist (replacements) + "Find and replace text in buffer according to REPLACEMENTS, +which is an alist where the car of each element is the text to +replace and the cdr is the replacement text. " + (dolist (rep replacements) + (save-excursion + (while (search-forward (car rep) nil t) + (replace-match (cdr rep) nil t))))) + +(defun which-key/insert-keys (formatted-strings) + (let ((char-count 0)) + (insert + (mapconcat + (lambda (str) + (let* ((str-len (length (substring-no-properties str))) + (new-count (+ char-count str-len))) + (if (> new-count which-key-buffer-width) + (progn (setq char-count str-len) + (concat "\n" str)) + (setq char-count new-count) + str))) formatted-strings "")))) + +(defun which-key/update-buffer-and-show () + (let ((key (this-single-command-keys))) + (when (> (length key) 0) + (let ((buf (current-buffer)) + (key-str-qt (regexp-quote (key-description key))) + unformatted formatted) + (with-current-buffer (get-buffer-create "*which-key*") + (erase-buffer) + (describe-buffer-bindings buf key) + (goto-char (point-max)) + (let ((max-len-key 0) (max-len-desc 0) key-match desc-match) + (while (re-search-backward + (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt) + nil t) + (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1)) + desc-match (match-string 2) + max-len-key (max max-len-key (length key-match)) + max-len-desc (max max-len-desc (length desc-match))) + (cl-pushnew (cons key-match desc-match) unformatted + :test (lambda (x y) (string-equal (car x) (car y))))) + (setq max-len-desc (if (> max-len-desc which-key-max-description-length) + (+ 2 which-key-max-description-length) + max-len-desc)) + (setq formatted (mapcar (lambda (str) + (which-key/format-matches str max-len-key max-len-desc)) + unformatted))) + (erase-buffer) + (which-key/insert-keys formatted) + (goto-char (point-min)) + (which-key/replace-strings-from-alist which-key-description-replacement-alist))) + (which-key/popup-buffer)))) + +(defun which-key/popup-buffer () + (popwin:popup-buffer (get-buffer-create "*which-key*") + :position which-key-buffer-position + :noselect t + ;; :height which-key/popup-window-size) + :width which-key-buffer-width)) + +(defun which-key/turn-on-timer () + (setq which-key-timer + (run-with-idle-timer which-key-idle-delay t 'which-key/update-buffer-and-show))) + +(defun which-key/turn-off-timer () + (cancel-timer which-key-timer)) + -- 2.30.2